home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / graphic / tpega.zip / COLORS.PAS < prev    next >
Pascal/Delphi Source File  |  1986-02-01  |  2KB  |  78 lines
  1. {                                                                             }
  2. {       EGA Graphic Demonstration, Turbo Pascal 3.01A, Version 10JAN86.       }
  3. {       (C) 1986 by Kent Cedola, 2015 Meadow Lake Ct., Norfolk, VA, 23518     }
  4. {                                                                             }
  5. {       This program will display over a hundred different colors by using    }
  6. {       a bit color map.  Only the standard palette setting are used, if      }
  7. {       changed, more colors could be produced (but not at the same time).    }
  8. {                                                                             }
  9.  
  10. program Colors;
  11.  
  12. {$K- }
  13.  
  14. var
  15.   x,y:  integer;
  16.   buffer: array [0..639] of Byte;
  17.  
  18. {$I GPParms.p }
  19. {$I GPInit.p  }
  20. {$I GPTerm.p  }
  21. {$I GPMOVE.P  }
  22. {$I GPWtRow.p }
  23.  
  24. begin { Main program }
  25.  
  26.   GPParms;
  27.  
  28.   if GDTYPE <> 5 then
  29.     begin
  30.     ClrScr;
  31.     Writeln('Enhanced Graphic Adapter and Display not found!');
  32.     Halt(1);
  33.     end;
  34.  
  35.   if GDMEMORY = 64 then
  36.     begin
  37.     ClrScr;
  38.     Writeln('This program works much better with 128k or more EGA memory!');
  39.     Writeln;
  40.     Writeln('   Hit any key to continue...');
  41.     Readln;
  42.     end;
  43.  
  44.   GPInit;
  45.  
  46.   y := 0;
  47.   while (y < GDMAXROW)
  48.     begin
  49.     x := 0;
  50.     while (x < GDMAXCOL)
  51.       begin
  52.       buffer[x]   := y * GDMAXPAL div GDMAXROW;
  53.       buffer[x+1] := x div 40;
  54.       x := x + 2;
  55.       end;
  56.  
  57.     GPMOVE(0,y);
  58.     GPWtRow(buffer,GDMAXCOL);
  59.     y := y + 1;
  60.  
  61.     x := 0;
  62.     while (x < GDMAXCOL)
  63.       begin
  64.       buffer[x]   := x div 40;
  65.       buffer[x+1] := y * GDMAXPAL div GDMAXROW;
  66.       x := x + 2;
  67.       end;
  68.     GPMOVE(0,y);
  69.     GPWtRow(buffer,GDMAXCOL);
  70.     y := y + 1;
  71.     end;
  72.  
  73.   Readln;
  74.  
  75.   GPTerm;
  76.  
  77. end.
  78.